home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / talk_sou / my_libra / myfilesy.uni < prev    next >
Text File  |  1992-04-20  |  8KB  |  333 lines
  1. unit MyFileSystem;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7.     const
  8.         PAvailable = fsCurPerm;
  9.         PIn = fsRdPerm;
  10.         POut = fsWrPerm;
  11.         PInOut = fsRdWrPerm;
  12.         PShared = fsRdWrShPerm;
  13.         buf_size = 2048;
  14.         eof_byte = $1A;
  15.  
  16.     type
  17.         bufferArray = packed array[0..buf_size] of byte;
  18.         bufferPtr = ^bufferArray;
  19.         bufferHandle = ^bufferPtr;
  20.         MFSfile = record
  21.                 reading: boolean;
  22.                 rn: integer;
  23.                 buf_len, buf_pos: longInt;
  24.                 eof: boolean;
  25.                 length: longInt;
  26.                 buf: bufferHandle;
  27.             end;
  28.  
  29.     function MFSExists (wdrn: integer; dirID: longInt; name: str255): boolean;
  30.     function MFSDirExists (wdrn: integer; dirID: longInt; name: str255): boolean;
  31.     procedure MFSUniqueName (wdrn: integer; dirID: longInt; var name: str63);
  32.     function MFSOpenIn (wdrn: integer; dirID: longInt; name: str255; var thefile: MFSfile): OSErr;
  33.     function MFSCreate (wdrn: integer; dirID: longInt; name: str255; c, t: OSType): OSErr;
  34. {    function MFSDelete (wdrn: integer; dirID: longInt; name: str255): OSErr;}
  35. { use HDelete instead}
  36.     function MFSOpenOutDF (wdrn: integer; dirID: longInt; name: str255; c, t: OSType; var thefile: MFSfile): OSErr;
  37.     function MFSOpenOutRF (wdrn: integer; dirID: longInt; name: str255; c, t: OSType; var thefile: MFSfile): OSErr;
  38.     function MFSEof (var thefile: MFSfile): boolean;
  39.     function MFSLength (var thefile: MFSfile): longInt;
  40.     function MFSReadByte (var thefile: MFSfile; var b: byte): OSErr;
  41.     function MFSWriteByte (var thefile: MFSfile; b: byte): OSErr;
  42.     function MFSClose (var thefile: MFSfile): OSErr;
  43.     function MFSOpenDF (var rn: integer; wdrn: integer; dirID: longInt; name: str63; perm: integer): OSErr;
  44.     function MFSOpenRF (var rn: integer; wdrn: integer; dirID: longInt; name: str63; perm: integer): OSErr;
  45. { perm = fsCurPerm, fsRdPerm, fsWrPerm, fsRdWrPerm, fsRdWrShPerm }
  46.     procedure SegmentMFSByte;
  47.     procedure SegmentMFS;
  48.  
  49. implementation
  50.  
  51.     uses
  52.         MyTypes;
  53.  
  54. {$S MFSByte}
  55.     procedure SegmentMFSByte;
  56.     begin
  57.     end;
  58.  
  59. {$S MFS}
  60.     procedure SegmentMFS;
  61.     begin
  62.     end;
  63.  
  64. {$S MFSByte}
  65.     procedure InitTheFile (var thefile: MFSfile);
  66.     begin
  67.         thefile.buf := bufferHandle(NewHandle(buf_size));
  68.     end;
  69.  
  70. {$S MFS}
  71.     function MFSExists (wdrn: integer; dirID: longInt; name: str255): boolean;
  72.         var
  73.             pb: HParamBlockRec;
  74.     begin
  75.         with pb do begin
  76.             ioNamePtr := @name;
  77.             ioVRefNum := wdrn;
  78.             ioDirID := dirID;
  79.             ioFDirIndex := 0;
  80.         end;
  81.         MFSExists := PBHGetFInfo(@pb, false) = noErr;
  82.     end;
  83.  
  84. {$S MFS}
  85.     function MFSDirExists (wdrn: integer; dirID: longInt; name: str255): boolean;
  86.         var
  87.             pb: HParamBlockRec;
  88.             oe: OSErr;
  89.     begin
  90.         with pb do begin
  91.             ioNamePtr := @name;
  92.             ioVRefNum := wdrn;
  93.             ioDirID := dirID;
  94.             if name = '' then
  95.                 ioFDirIndex := -1
  96.             else
  97.                 ioFDirIndex := 0;
  98.         end;
  99.         oe := PBGetCatInfo(@pb, false);
  100.         MFSDirExists := (oe = noErr) and (BAND(pb.ioFlAttrib, $0010) <> 0);
  101.     end;
  102.  
  103. {$S MFS}
  104.     procedure MFSUniqueName (wdrn: integer; dirID: longInt; var name: str63);
  105.         var
  106.             base: str31;
  107.             n: integer;
  108.     begin
  109.         if MFSExists(wdrn, dirID, name) then begin
  110.             base := Concat(Copy(name, 1, 27), '#');
  111.             n := 1;
  112.             repeat
  113.                 name := Concat(base, chr(n div 100 + 48), chr(n div 10 mod 10 + 48), chr(n mod 10 + 48));
  114.                 n := n + 1;
  115.             until not MFSExists(wdrn, dirID, name);
  116.         end;
  117.     end;
  118.  
  119. {$S MFSByte}
  120.     function MFSOpenIn (wdrn: integer; dirID: longInt; name: str255; var thefile: MFSfile): OSErr;
  121.     begin
  122.         InitTheFile(thefile);
  123.         with thefile do begin
  124.             reading := true;
  125.             buf_pos := 0;
  126.             buf_len := 0;
  127.             MFSOpenIn := MFSOpenDF(rn, wdrn, dirID, name, PIn);
  128.             if GetEOF(rn, length) <> noErr then
  129.                 length := 0;
  130.             eof := length = 0;
  131.         end;
  132.     end;
  133.  
  134. {$S MFS}
  135.     function MFSCreate (wdrn: integer; dirID: longInt; name: str255; c, t: OSType): OSErr;
  136.         var
  137.             ooe, oe: integer;
  138.             fi: Finfo;
  139.     begin
  140.         oe := HCreate(wdrn, dirID, name, c, t);
  141.         if oe = dupFNErr then begin
  142.             ooe := HGetFInfo(wdrn, dirID, name, fi);
  143.             oe := HDelete(wdrn, dirID, name);
  144.             oe := HCreate(wdrn, dirID, name, c, t);
  145.             if (oe = noErr) and (ooe = noErr) then begin
  146.                 fi.fdType := t;
  147.                 fi.fdCreator := c;
  148.                 ooe := HSetFInfo(wdrn, dirID, name, fi);
  149.             end;
  150.         end;
  151.         MFSCreate := oe;
  152.     end;
  153.  
  154. {$S MFSByte}
  155.     function MFSOpenOutDF (wdrn: integer; dirID: longInt; name: str255; c, t: OSType; var thefile: MFSfile): OSErr;
  156.         var
  157.             oe: integer;
  158.             fi: fInfo;
  159.     begin
  160.         InitTheFile(thefile);
  161.         with thefile do begin
  162.             reading := false;
  163.             oe := MFSCreate(wdrn, dirID, name, c, t);
  164.             if oe = noErr then
  165.                 oe := MFSOpenDF(rn, wdrn, dirID, name, POut);
  166.             buf_pos := 0;
  167.             buf_len := 0;
  168.             length := 0;
  169.             eof := false;
  170.             MFSOpenOutDF := oe;
  171.         end;
  172.     end;
  173.  
  174. {$S MFSByte}
  175.     function MFSOpenOutRF (wdrn: integer; dirID: longInt; name: str255; c, t: OSType; var thefile: MFSfile): OSErr;
  176.         var
  177.             oe: integer;
  178.     begin
  179.         InitTheFile(thefile);
  180.         with thefile do begin
  181.             reading := false;
  182.             oe := MFSCreate(wdrn, dirID, name, c, t);
  183.             if oe = dupFNErr then
  184.                 oe := noErr;
  185.             if oe = noErr then
  186.                 oe := MFSOpenRF(rn, wdrn, dirID, name, POut);
  187.             buf_pos := 0;
  188.             buf_len := 0;
  189.             length := 0;
  190.             eof := false;
  191.             MFSOpenOutRF := oe;
  192.         end;
  193.     end;
  194.  
  195. {$S MFSByte}
  196.     function MFSLength (var thefile: MFSfile): longInt;
  197.         var
  198.             l: longInt;
  199.     begin
  200.         MFSLength := thefile.length;
  201.     end;
  202.  
  203. {$S MFSByte}
  204.     function MFSEof (var thefile: MFSfile): boolean;
  205.     begin
  206.         MFSEof := thefile.eof;
  207.     end;
  208.  
  209. {$S MFSByte}
  210.     function MFSReadByte (var thefile: MFSfile; var b: byte): OSErr;
  211.         var
  212.             oe: OSErr;
  213.         procedure Read;
  214.         begin
  215.             with thefile do begin
  216.                 buf_pos := 0;
  217.                 buf_len := buf_size;
  218.                 oe := FSRead(rn, buf_len, POINTER(buf^));
  219.                 if oe = eofErr then
  220.                     oe := noErr;
  221.                 if buf_len = 0 then
  222.                     oe := eofErr;
  223.                 if oe <> noErr then begin
  224.                     buf_len := 0;
  225.                     eof := true;
  226.                 end;
  227.             end;
  228.         end;
  229.     begin
  230.         with thefile do
  231.             if reading then begin
  232.                 if eof then begin
  233.                     b := eof_byte;
  234.                     MFSReadByte := eofErr;
  235.                 end
  236.                 else begin
  237.                     oe := noErr;
  238.                     if buf_pos = buf_len then
  239.                         Read;
  240.                     MFSReadByte := oe;
  241.                     if oe = noErr then begin
  242.                         b := buf^^[buf_pos];
  243.                         buf_pos := buf_pos + 1;
  244.                         if buf_pos = buf_len then
  245.                             Read;
  246.                     end;
  247.                 end;
  248.             end
  249.             else
  250.                 MFSReadByte := paramErr;
  251.     end;
  252.  
  253. {$S MFSByte}
  254.     function Flush (var thefile: MFSfile): OSErr;
  255.         var
  256.             count: longInt;
  257.             oe: integer;
  258.     begin
  259.         with thefile do begin
  260.             count := buf_pos;
  261.             if count = 0 then
  262.                 oe := noErr
  263.             else
  264.                 oe := FSWrite(rn, count, POINTER(buf^));
  265.             if count <> buf_pos then
  266.                 oe := ioErr;
  267.             buf_len := 0;
  268.             buf_pos := 0;
  269.         end;
  270.         Flush := oe;
  271.     end;
  272.  
  273. {$S MFSByte}
  274.     function MFSWriteByte (var thefile: MFSfile; b: byte): OSErr;
  275.     begin
  276.         with thefile do
  277.             if not reading then begin
  278.                 buf^^[buf_pos] := b;
  279.                 buf_pos := buf_pos + 1;
  280.                 if buf_pos = buf_size then
  281.                     MFSWriteByte := Flush(thefile)
  282.                 else
  283.                     MFSWriteByte := noErr;
  284.             end
  285.             else
  286.                 MFSWriteByte := paramErr;
  287.     end;
  288.  
  289. {$S MFSByte}
  290.     function MFSClose (var thefile: MFSfile): OSErr;
  291.         var
  292.             oe: integer;
  293.     begin
  294.         if not thefile.reading then
  295.             oe := Flush(thefile);
  296.         MFSClose := FSClose(thefile.rn);
  297.         thefile.rn := 0;                { Never close a file twice }
  298.         DisposHandle(handle(thefile.buf));
  299.     end;
  300.  
  301. {$S MFS}
  302.     function MFSOpenDF (var rn: integer; wdrn: integer; dirID: longInt; name: str63; perm: integer): OSErr;
  303.         var
  304.             pb: HParamBlockRec;
  305.     begin
  306.         with pb do begin
  307.             ioNamePtr := @name;
  308.             ioVRefNum := wdrn;
  309.             ioPermssn := perm;
  310.             ioMisc := nil;
  311.             ioDirID := dirID;
  312.             MFSOpenDF := PBHOpen(@pb, false);
  313.             rn := ioRefNum;
  314.         end;
  315.     end;
  316.  
  317. {$S MFS}
  318.     function MFSOpenRF (var rn: integer; wdrn: integer; dirID: longInt; name: str63; perm: integer): OSErr;
  319.         var
  320.             pb: HParamBlockRec;
  321.     begin
  322.         with pb do begin
  323.             ioNamePtr := @name;
  324.             ioVRefNum := wdrn;
  325.             ioPermssn := perm;
  326.             ioMisc := nil;
  327.             ioDirID := dirID;
  328.             MFSOpenRF := PBHOpenRF(@pb, false);
  329.             rn := ioRefNum;
  330.         end;
  331.     end;
  332.  
  333. end.